home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 1601_700 / DISK1617 / DISK1617.ZIP / ADDRBOOK.SBA < prev    next >
Text File  |  1989-11-25  |  9KB  |  295 lines
  1. `***********************************************************************
  2. `**                                                                   **
  3. `** This program is written in S-BASIC by Robert Pearce               **
  4. `**                                                                   **
  5. `***********************************************************************
  6. `
  7. `       This is a simple database program that makes use of the DISAM
  8. `   Functions. First you fill out what is needed on the screen then
  9. `   you enter a function key + a C/R. You can add, change, delete or
  10. `   display the DISAM records.
  11. `
  12. `       To use this program, define a DISAM file using the following:
  13. `           filename:   ADDRBOOK.DSF
  14. `           Key length: 10
  15. `           Key offset: 0
  16. `           Use the index and data block size defaults
  17. `           Share:      N
  18. `
  19. `       Subroutines: VERIFY.DFH3.LOADED and ACCESS.DFH3 are the one's
  20. `   that actually go outside the BASIC's environment.
  21. `
  22. `       This program is written in S-BASIC, (Structured BASIC). This
  23. `   is a product purchased from Sunflower Software, 13915 midland Dr.
  24. `   Shawnee, KS. 65215 in 1986. This code is fed into S-BASIC which
  25. `   is a pre-processor that converts this file into a GW-BASIC program
  26. `   which is passed to the Microsoft BASIC compiler and out comes an
  27. `   executable module.
  28. `
  29. GOSUB INITIALIZE.CONSTANTS
  30. GOSUB VERIFY.DFH3.LOADED
  31. GOSUB OPEN.FILE
  32. GOSUB DISPLAY.SCREEN
  33. GOSUB SET.SOFT.KEYS
  34. WHILE Z<>1 DO
  35.     GOSUB PROCESS
  36. END WHILE
  37. SYSTEM
  38. END
  39.  
  40. SUB INITIALIZE.CONSTANTS        'initialization routine
  41.     DIM FLD$(5)                 'five fields defined.
  42.     FILE$="ADDRBOOK.DSF"        'file name.
  43.     KEY.LEN=10                  'key length is 10 bytes
  44.     KEY.OFF=0                   'starting at offset 0.
  45.     MAX.REC.LEN=255             'BASIC record length constraint
  46.     DELIMITER$=CHR$(01)         'delimiter is a CTRL-A
  47.     X$=""                       'tempy string area
  48.     Z=0                         'end of program indicator
  49.     NAM.LEN=30                  'define field maximum lengths
  50.     ADR1.LEN=40
  51.     ADR2.LEN=40
  52.     CSZ.LEN=40
  53.     PHO.LEN=15
  54. `   MAX RECORD LENGTH IS 165+5 = 170     (1 delimiter per field)
  55. `   MIN RECORD LENGTH IS KEY.LEN+5 = 15  (5 delimiters)
  56.     RETURN
  57.  
  58. SUB DISPLAY.SCREEN              'these are screen constants
  59.     CLS
  60.     LOCATE 3,27
  61.     PRINT "Sample DISAM Program";
  62.     LOCATE 4,12
  63.     PRINT "When a Fn key is used, it must be followed by a C/R"
  64.     LOCATE 7,19
  65.     PRINT "Name:";
  66.     LOCATE 9,16
  67.     PRINT "Address:";
  68.     LOCATE 11,16
  69.     PRINT "Address:";
  70.     LOCATE 13,10
  71.     PRINT "City, St. Zip:";
  72.     LOCATE 15,12
  73.     PRINT "Telephone #:";
  74.     RETURN
  75.  
  76. SUB SET.SOFT.KEYS               'function key setup
  77.     DATA "AddRec","","ChgRec","","DelRec","","GetRec","","ClrScn","End"
  78.     KEY OFF
  79.     FOR N=1 TO 10 DO
  80.         READ SOFTKEY$
  81.         KEY N,SOFTKEY$
  82.     NEXT N
  83.     KEY ON
  84.     ON KEY(1) GOSUB ADD.RECORD
  85.     KEY(1) ON
  86.     ON KEY(3) GOSUB CHANGE.RECORD
  87.     KEY(3) ON
  88.     ON KEY(5) GOSUB DELETE.RECORD
  89.     KEY(5) ON
  90.     ON KEY(7) GOSUB DISPLAY.RECORD
  91.     KEY(7) ON
  92.     ON KEY(9) GOSUB CLEAR.SCREEN
  93.     KEY(9) ON
  94.     ON KEY(10) GOSUB END.SESSION
  95.     KEY(10) ON
  96.     RETURN
  97.  
  98. SUB PROCESS                     'get input from screen
  99.     LOCATE 7,25                 'position cursor
  100.     LINE INPUT X$               'get input
  101.     IF LEN(X$)<>0 THEN
  102.         NAME$=X$                'if something was entered, use it
  103.     END IF
  104.     LOCATE 17,25                'clear the info line
  105.     PRINT SPACE$(50)
  106.     LOCATE 9,25                 'get input 4 more times
  107.     LINE INPUT X$
  108.     IF LEN(X$)<>0 THEN
  109.         ADDR1$=X$
  110.     END IF
  111.     LOCATE 11,25
  112.     LINE INPUT X$
  113.     IF LEN(X$)<>0 THEN
  114.         ADDR2$=X$
  115.     END IF
  116.     LOCATE 13,25
  117.     LINE INPUT X$
  118.     IF LEN(X$)<>0 THEN
  119.         CSZ$=X$
  120.     END IF
  121.     LOCATE 15,25
  122.     LINE INPUT X$
  123.     IF LEN(X$)<>0 THEN
  124.         PHONE$=X$
  125.     END IF
  126.     RETURN
  127.  
  128. SUB END.SESSION                 'close DISAM file and exit
  129.     GOSUB CLOSE.FILE
  130.     Z=1
  131.     SYSTEM
  132.     RETURN
  133.  
  134. SUB ADD.RECORD                  'add a record to the DISAM file
  135.     GOSUB EDIT.KEY.LENGTH
  136.     GOSUB BUILD.RECORD
  137.     FUNC$="A"                   'add action
  138.     REC$=TMP$                   'input record
  139.     GOSUB ACCESS.DFH3
  140.     IF REC$="2" THEN
  141.         LOCATE 17,25            'display error
  142.         PRINT "Record already exists                    ";
  143.     ELSE
  144.         GOSUB CLEAR.SCREEN
  145.     END IF
  146.     RETURN
  147.  
  148. SUB EDIT.KEY.LENGTH             'insure key is at least key.len long
  149.     IF LEN(NAME$)<KEY.LEN THEN
  150.         NAME$=NAME$+SPACE$(KEY.LEN-LEN(NAME$))
  151.     END IF
  152.     RETURN
  153.  
  154. SUB BUILD.RECORD                'concatinate fields
  155.     TMP$=NAME$+DELIMITER$+ADDR1$+DELIMITER$+ADDR2$+DELIMITER$
  156.     TMP$=TMP$+CSZ$+DELIMITER$+PHONE$+DELIMITER$
  157.     RETURN
  158.  
  159. SUB CLEAR.SCREEN                'clear screen and field values
  160.     LOCATE 07,25
  161.     PRINT SPACE$(NAM.LEN)
  162.     NAME$=""
  163.     LOCATE 09,25
  164.     PRINT SPACE$(ADR1.LEN)
  165.     ADDR1$=""
  166.     LOCATE 11,25
  167.     PRINT SPACE$(ADR2.LEN)
  168.     ADDR2$=""
  169.     LOCATE 13,25
  170.     PRINT SPACE$(CSZ.LEN)
  171.     CSZ$=""
  172.     LOCATE 15,25
  173.     PRINT SPACE$(PHO.LEN)
  174.     PHONE$=""
  175.     LOCATE 17,25
  176.     PRINT SPACE$(50)
  177.     RETURN
  178.  
  179. SUB DISPLAY.RECORD              'get a DISAM record
  180.     GOSUB EDIT.KEY.LENGTH
  181.     FUNC$="G"
  182.     REC$=NAME$+SPACE$(MAX.REC.LEN-LEN(NAME$)) 'send a 255 byte field
  183.     GOSUB ACCESS.DFH3                         'to DISAM for record
  184.     IF REC$="1" THEN
  185.         LOCATE 17,25
  186.         PRINT "Record not found                         ";
  187.     ELSE IF REC$="3"
  188.         GOSUB CLEAR.SCREEN
  189.         LOCATE 17,25
  190.         PRINT "You have reached the end of the file     ";
  191.     ELSE
  192.         GOSUB CLEAR.SCREEN
  193.         GOSUB PARSE.RECORD
  194.         GOSUB DISPLAY.FIELDS
  195.     END IF
  196.     RETURN
  197.  
  198. SUB PARSE.RECORD                'split the record into 5 fields
  199.     FOR I=1 TO 5 DO
  200.         J=INSTR(1,REC$,DELIMITER$)
  201.         FLD$(I)=MID$(REC$,1,J-1)
  202.         REC$=MID$(REC$,J+1)
  203.     NEXT
  204.     NAME$=FLD$(1)
  205.     ADDR1$=FLD$(2)
  206.     ADDR2$=FLD$(3)
  207.     CSZ$=FLD$(4)
  208.     PHONE$=FLD$(5)
  209.     RETURN
  210.  
  211. SUB DISPLAY.FIELDS              'display the fields
  212.     LOCATE 7,25
  213.     PRINT NAME$;
  214.     LOCATE 9,25
  215.     PRINT ADDR1$;
  216.     LOCATE 11,25
  217.     PRINT ADDR2$;
  218.     LOCATE 13,25
  219.     PRINT CSZ$;
  220.     LOCATE 15,25
  221.     PRINT PHONE$;
  222.     RETURN
  223.  
  224. SUB CHANGE.RECORD               'replace the DISAM record
  225.     GOSUB EDIT.KEY.LENGTH
  226.     GOSUB BUILD.RECORD
  227.     FUNC$="P"
  228.     REC$=TMP$
  229.     GOSUB ACCESS.DFH3
  230.     IF REC$="1" THEN
  231.         LOCATE 17,25
  232.         PRINT "Record not found                         ";
  233.     ELSE
  234.         GOSUB CLEAR.SCREEN
  235.     END IF
  236.     RETURN
  237.  
  238. SUB DELETE.RECORD               'delete the DISAM record
  239.     GOSUB EDIT.KEY.LENGTH
  240.     FUNC$="D"
  241.     REC$=NAME$
  242.     IF LEN(REC$)<>0 THEN
  243.        GOSUB ACCESS.DFH3
  244.        IF REC$="1" THEN
  245.            LOCATE 17,25
  246.            PRINT "Record not found                         ";
  247.        ELSE
  248.            GOSUB CLEAR.SCREEN
  249.        END IF
  250.     END IF
  251.     RETURN
  252.  
  253. SUB VERIFY.DFH3.LOADED          'verify DISAM is loaded in the system
  254.     DEF SEG=&H0012
  255.     X=PEEK(&H0)
  256.     DEF SEG
  257.     IF X<>234 THEN
  258.         PRINT "DISAM File Handler is not loaded."
  259.         STOP
  260.     END IF
  261.     RETURN
  262.  
  263. SUB OPEN.FILE                   'open the DISAM file
  264.     FUNC$="F"                   'insure that the buffer is available
  265.     REC$="  "
  266.     GOSUB ACCESS.DFH3
  267.     FUNC$="O"                   'and then open the file
  268.     REC$=FILE$+""
  269.     GOSUB ACCESS.DFH3
  270.     RETURN                      'assume a "0" return-code
  271.  
  272. SUB CLOSE.FILE                  'close the DISAM file
  273.     FUNC$="C"
  274.     REC$=" "
  275.     GOSUB ACCESS.DFH3
  276.     RETURN                      'assume a "0" return-code
  277.  
  278. SUB ACCESS.DFH3                 'this is the DISAM access routine
  279.     ERR.F$=FUNC$                'Store stuff for possible error
  280.     ERR.R$=REC$
  281.     DEF SEG=&H0012              'point SEG addr to DISAM epa
  282.     DFH3=&H0
  283.     CALL ABSOLUTE (FUNC$,REC$,DFH3)
  284.     DEF SEG
  285.     IF ERR.F$="F"THEN RETURN    'do not edit the FREE function
  286.     IF REC$="9" THEN
  287.         PRINT "Unexpected response from DFH3"
  288.                                     'process internal errors here
  289.         PRINT "FUNC= ";ERR.F$       'also display what was sent
  290.         PRINT "REC= ";ERR.R$        'to DISAM to help debug
  291.         STOP
  292.     END IF
  293.     RETURN
  294. END PROGRAM
  295.